PC go! 2008 April/PCgo 2008-04 (DVD).iso/interface/contents/demoversionen_3846/13664/files/Data1.cab/frmcadgx.frm

Visual Basic Form | 2004-03-03 | 15.3 KB | 530 lines

VERSION 5.00
Object = "{33B81F60-5683-42D6-8682-E4AE5FEADC5E}#1.0#0"; "TcViewer.ocx"
Begin VB.Form frmCADGX
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TurboCAD SDK Client sample application"
   ClientHeight    =   7110
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   10590
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7110
   ScaleWidth      =   10590
   StartUpPosition =   3  'Windows Default
   Begin prjTcViewer.ctlTcViewer ctlTcViewer2
      Height          =   4812
      Left            =   5760
      TabIndex        =   29
      Top             =   120
      Width           =   4452
      _ExtentX        =   7858
      _ExtentY        =   8493
   End
   Begin prjTcViewer.ctlTcViewer ctlTcViewer1
      Height          =   4812
      Left            =   480
      TabIndex        =   28
      Top             =   120
      Width           =   4452
      _ExtentX        =   7858
      _ExtentY        =   8493
   End
   Begin VB.CommandButton btnSetAperture2
      Caption         =   "Set"
      Height          =   300
      Left            =   8760
      TabIndex        =   27
      Top             =   5268
      Width           =   1428
   End
   Begin VB.CommandButton btnSetAperture1
      Caption         =   "Set"
      Height          =   300
      Left            =   3480
      TabIndex        =   26
      Top             =   5268
      Width           =   1428
   End
   Begin VB.TextBox txtAperture2
      Height          =   288
      Left            =   7968
      TabIndex        =   24
      Top             =   5280
      Width           =   732
   End
   Begin VB.TextBox txtAperture1
      Height          =   288
      Left            =   2688
      TabIndex        =   22
      Top             =   5268
      Width           =   732
   End
   Begin VB.CommandButton btnNew2
      Caption         =   "New Drawing"
      Height          =   372
      Left            =   5772
      TabIndex        =   21
      Top             =   6096
      Width           =   1452
   End
   Begin VB.CommandButton btnNew1
      Caption         =   "New Drawing"
      Height          =   372
      Left            =   468
      TabIndex        =   20
      Top             =   6132
      Width           =   1452
   End
   Begin VB.CommandButton btnSpace2
      Height          =   252
      Left            =   10200
      TabIndex        =   19
      Top             =   4920
      Width           =   252
   End
   Begin VB.CommandButton btnSpace1
      Height          =   252
      Left            =   240
      TabIndex        =   18
      Top             =   4920
      Width           =   252
   End
   Begin VB.CommandButton btnZoomIn2
      Caption         =   "Zoom In"
      Height          =   372
      Left            =   5772
      TabIndex        =   17
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomAll2
      Caption         =   "Zoom All"
      Height          =   372
      Left            =   7272
      TabIndex        =   16
      Top             =   5664
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomOut2
      Caption         =   "Zoom Out"
      Height          =   372
      Left            =   8772
      TabIndex        =   15
      Top             =   5676
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomIn1
      Caption         =   "Zoom In"
      Height          =   372
      Left            =   480
      TabIndex        =   14
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomAll1
      Caption         =   "Zoom All"
      Height          =   372
      Left            =   3480
      TabIndex        =   13
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomOut1
      Caption         =   "Zoom Out"
      Height          =   372
      Left            =   1980
      TabIndex        =   12
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnCopy21
      Caption         =   "<-"
      Height          =   372
      Left            =   5040
      TabIndex        =   11
      Top             =   2400
      Width           =   612
   End
   Begin VB.CommandButton btncCopy12
      Caption         =   "->"
      Height          =   372
      Left            =   5040
      TabIndex        =   10
      Top             =   1920
      Width           =   612
   End
   Begin VB.HScrollBar HScroll1
      Height          =   252
      Left            =   480
      Max             =   10
      TabIndex        =   9
      Top             =   4920
      Value           =   5
      Width           =   4452
   End
   Begin VB.HScrollBar HScroll2
      Height          =   252
      Left            =   5760
      Max             =   10
      TabIndex        =   8
      Top             =   4920
      Value           =   5
      Width           =   4452
   End
   Begin VB.VScrollBar VScroll2
      Height          =   4812
      Left            =   10200
      Max             =   10
      TabIndex        =   7
      Top             =   120
      Value           =   5
      Width           =   252
   End
   Begin VB.VScrollBar VScroll1
      Height          =   4812
      Left            =   240
      Max             =   10
      TabIndex        =   6
      Top             =   120
      Value           =   5
      Width           =   252
   End
   Begin VB.CommandButton btnSave2
      Caption         =   "Save Drawing"
      Height          =   372
      Left            =   7272
      TabIndex        =   5
      Top             =   6576
      Width           =   1452
   End
   Begin VB.CommandButton btnClose2
      Caption         =   "Close Drawing"
      Height          =   372
      Left            =   8772
      TabIndex        =   4
      Top             =   6108
      Width           =   1452
   End
   Begin VB.CommandButton btnOpen2
      Caption         =   "Open Drawing"
      Height          =   372
      Left            =   7272
      TabIndex        =   3
      Top             =   6096
      Width           =   1452
   End
   Begin VB.CommandButton btnSave
      Caption         =   "Save Drawing"
      Height          =   372
      Left            =   1956
      TabIndex        =   2
      Top             =   6600
      Width           =   1452
   End
   Begin VB.CommandButton btnClose1
      Caption         =   "Close Drawing"
      Height          =   372
      Left            =   3480
      TabIndex        =   1
      Top             =   6144
      Width           =   1452
   End
   Begin VB.CommandButton btnOpen1
      Caption         =   "Open Drawing"
      Height          =   372
      Left            =   1968
      TabIndex        =   0
      Top             =   6132
      Width           =   1440
   End
   Begin VB.Label Label2
      Caption         =   "Select  Aperture:"
      Height          =   276
      Left            =   6612
      TabIndex        =   25
      Top             =   5292
      Width           =   1212
   End
   Begin VB.Label Label1
      Caption         =   "Select  Aperture:"
      Height          =   216
      Left            =   1332
      TabIndex        =   23
      Top             =   5280
      Width           =   1212
   End
Attribute VB_Name = "frmCADGX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************'
'*                                                                *'
'*                      TurboCAD for Windows                      *'
'*                   Copyright (c) 1993 - 2001                    *'
'*             International Microcomputer Software, Inc.         *'
'*                            (IMSI)                              *'
'*                      All rights reserved.                      *'
'*                                                                *'
'******************************************************************'
Option Explicit
Dim gxApp As New XApplication
Dim gxDwg1 As Drawing
Dim gxDwg2 As Drawing
Private Sub CloseDrawing1()
    ctlTcViewer1.Detach
    ctlTcViewer1.Refresh
    If (Not gxDwg1 Is Nothing) Then
        gxDwg1.Close
        Set gxDwg1 = Nothing
    End If
    btnSpace1.Caption = ""
    txtAperture1 = ""
End Sub
Private Sub CloseDrawing2()
    ctlTcViewer2.Detach
    ctlTcViewer2.Refresh
    If (Not gxDwg2 Is Nothing) Then
        gxDwg2.Close
        Set gxDwg2 = Nothing
    End If
    btnSpace2.Caption = ""
    txtAperture2 = ""
End Sub
Private Sub OpenDrawing1(strFilePath As String)
    CloseDrawing1
    If (strFilePath <> "") Then
        Set gxDwg1 = gxApp.Drawings.Open(strFilePath)
    Else
        Set gxDwg1 = gxApp.Drawings.Add
    End If
    ctlTcViewer1.Attach gxDwg1
    If (ctlTcViewer1.ViewSpace) Then
        btnSpace1.Caption = "M"
    Else
        btnSpace1.Caption = "P"
    End If
    txtAperture1 = CStr(ctlTcViewer1.Aperture)
End Sub
Private Sub OpenDrawing2(strFilePath As String)
    CloseDrawing2
    On Error GoTo Err
    If (strFilePath <> "") Then
        Set gxDwg2 = gxApp.Drawings.Open(strFilePath)
    Else
        Set gxDwg2 = gxApp.Drawings.Add
    End If
    ctlTcViewer2.Attach gxDwg2
    If (ctlTcViewer2.ViewSpace) Then
        btnSpace2.Caption = "M"
    Else
        btnSpace2.Caption = "P"
    End If
    txtAperture2 = CStr(ctlTcViewer2.Aperture)
    Exit Sub
    If (Err.Number <> 0) Then
        MsgBox Err.Description
    End If
End Sub
Private Sub btncCopy12_Click()
    Dim gxGrSel As Graphic
    Dim gxSel As Selection
    On Error GoTo ErrHandler
    ctlTcViewer2.Update = False
    Set gxSel = gxDwg1.Selection
    For Each gxGrSel In gxSel
        MergeGraphic gxGrSel, gxDwg1, gxDwg2
    Next gxGrSel
ErrHandler:
    ctlTcViewer2.Update = True
    Set gxGrSel = Nothing
    Set gxSel = Nothing
End Sub
Private Sub btnClose1_Click()
    CloseDrawing1
End Sub
Private Sub btnClose2_Click()
    CloseDrawing2
End Sub
Private Sub btnCopy21_Click()
    Dim gxGrSel As Graphic
    Dim gxSel As Selection
    ctlTcViewer1.Update = False
    Set gxSel = gxDwg2.Selection
    For Each gxGrSel In gxSel
        MergeGraphic gxGrSel, gxDwg2, gxDwg1
    Next gxGrSel
    ctlTcViewer1.Update = True
ErrHandler:
    Set gxGrSel = Nothing
    Set gxSel = Nothing
End Sub
Private Sub btnNew1_Click()
    OpenDrawing1 ""
End Sub
Private Sub btnNew2_Click()
    OpenDrawing2 ""
End Sub
Private Sub btnOpen1_Click()
    On Error GoTo Err
    OpenDrawing1 gxApp.GetOpenFilename
End Sub
Private Sub btnOpen2_Click()
    On Error GoTo Err
    OpenDrawing2 gxApp.GetOpenFilename
End Sub
Private Sub btnSave_Click()
    On Error GoTo Err
    gxDwg1.SaveAs gxApp.GetSaveFilename
End Sub
Private Sub btnSave2_Click()
    On Error GoTo Err
    gxDwg2.SaveAs gxApp.GetSaveFilename
End Sub
Private Sub btnSetAperture1_Click()
    On Error Resume Next
    ctlTcViewer1.Aperture = CDbl(txtAperture1)
End Sub
Private Sub btnSetAperture2_Click()
    On Error Resume Next
    ctlTcViewer2.Aperture = CDbl(txtAperture2)
End Sub
Private Sub btnSpace1_Click()
    On Error GoTo ErrHandler
    If (ctlTcViewer1.ViewSpace) Then
        btnSpace1.Caption = "P"
        ctlTcViewer1.ViewSpace = 0
    Else
        btnSpace1.Caption = "M"
        ctlTcViewer1.ViewSpace = 1
    End If
    ctlTcViewer1.Zoom 0
    ctlTcViewer1.Refresh
ErrHandler:
End Sub
Private Sub btnSpace2_Click()
    On Error GoTo ErrHandler
    If (ctlTcViewer2.ViewSpace) Then
        btnSpace2.Caption = "P"
        ctlTcViewer2.ViewSpace = 0
    Else
        btnSpace2.Caption = "M"
        ctlTcViewer2.ViewSpace = 1
    End If
    ctlTcViewer2.Zoom 0
    ctlTcViewer2.Refresh
ErrHandler:
End Sub
Private Sub btnZoomAll1_Click()
    ctlTcViewer1.Zoom 0
    ctlTcViewer1.Refresh
End Sub
Private Sub btnZoomIn1_Click()
    ctlTcViewer1.Zoom 1 / 1.25
    ctlTcViewer1.Refresh
End Sub
Private Sub btnZoomOut1_Click()
    ctlTcViewer1.Zoom 1.25
    ctlTcViewer1.Refresh
End Sub
Private Sub btnZoomAll2_Click()
    ctlTcViewer2.Zoom 0
    ctlTcViewer2.Refresh
End Sub
Private Sub btnZoomIn2_Click()
    ctlTcViewer2.Zoom 1 / 1.25
    ctlTcViewer2.Refresh
End Sub
Private Sub btnZoomOut2_Click()
    ctlTcViewer2.Zoom 1.25
    ctlTcViewer2.Refresh
End Sub
Private Sub ctlTcViewer1_ClickGraphic(gxGr As IMSIGX.IGraphic, dist As Double)
    Dim gxGrSel As Graphic
    Dim gxSel As Selection
    Set gxSel = gxDwg1.Selection
    For Each gxGrSel In gxSel
        If (gxGrSel.ID = gxGr.ID) Then
            gxGrSel.Unselect
            GoTo Done
        End If
    Next gxGrSel
    'don't select graphic if it belongs to non-editable layer
    Dim gxLyr As Layer
    Set gxLyr = gxGr.Layer
    If gxLyr.Editable Then
        gxGr.Select
    End If
Done:
    Set gxGrSel = Nothing
    Set gxSel = Nothing
End Sub
Private Sub ctlTcViewer2_ClickGraphic(gxGr As IMSIGX.IGraphic, dist As Double)
    Dim gxGrSel As Graphic
    Dim gxSel As Selection
    Set gxSel = gxDwg2.Selection
    For Each gxGrSel In gxSel
        If (gxGrSel.ID = gxGr.ID) Then
            gxGrSel.Unselect
            GoTo Done
        End If
    Next gxGrSel
    'don't select graphic if it belongs to non-editable layer
    Dim gxLyr As Layer
    Set gxLyr = gxGr.Layer
    If gxLyr.Editable Then
        gxGr.Select
    End If
Done:
    Set gxGrSel = Nothing
    Set gxSel = Nothing
End Sub
Private Sub Form_Terminate()
    CloseDrawing1
    CloseDrawing2
    Set gxApp = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
    CloseDrawing1
    CloseDrawing2
    Set gxApp = Nothing
End Sub
Private Sub HScroll1_Change()
    Dim dx As Long
    dx = HScroll1.Value - 5
    If (dx <> 0) Then
        ctlTcViewer1.Scroll 0, dx
        HScroll1.Value = 5
    End If
    ctlTcViewer1.Refresh
End Sub
Private Sub VScroll1_Change()
    Dim dy As Long
    dy = VScroll1.Value - 5
    If (dy <> 0) Then
        ctlTcViewer1.Scroll dy, 0
        VScroll1.Value = 5
    End If
    ctlTcViewer1.Refresh
End Sub
Private Sub HScroll2_Change()
    Dim dx As Long
    dx = HScroll2.Value - 5
    If (dx <> 0) Then
        ctlTcViewer2.Scroll 0, dx
        HScroll2.Value = 5
    End If
    ctlTcViewer2.Refresh
End Sub
Private Sub VScroll2_Change()
    Dim dy As Long
    dy = VScroll2.Value - 5
    If (dy <> 0) Then
        ctlTcViewer2.Scroll dy, 0
        VScroll2.Value = 5
    End If
    ctlTcViewer2.Refresh
End Sub